home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 011 / frags.arc / FRAGS.PAS < prev   
Pascal/Delphi Source File  |  1987-03-24  |  13KB  |  381 lines
  1. {program written by Neil Judell to determine amount of fragmentation on disk}
  2. {recursively searches root directory, subdirectories, files for frags}
  3. {$B-}
  4. {Don't buffer the console}
  5. program fats(input,output);
  6.  
  7. const
  8.      sub_dir = 16;
  9.      dir_entry_size = 32;
  10.      deleted_entry = 'σ';
  11.      alias_entry = '.';
  12.      dir_entry = 16;
  13.      volable = 8;
  14.  
  15. type
  16.      str8 = packed array [0..7] of char;
  17.      str3 = packed array [0..2] of char;
  18.  
  19. {data type defines boot sector data areas}
  20.  
  21.      boot_sector_type = record
  22.                           disk_id : packed array[0..2] of byte;
  23.                           oem_name : packed array[0..7] of char;
  24.                           bytes_per_sector  : integer;
  25.                           sectors_per_cluster : byte;
  26.                           reserved_sect : integer;
  27.                           number_fats : byte;
  28.                           root_entries : integer;
  29.                           total_sectors : integer;
  30.                           media_type : byte;
  31.                           sectors_per_fat : integer;
  32.                           sectors_per_track : integer;
  33.                           number_of_heads : integer;
  34.                           the_rest : packed array[0..511] of byte;
  35.                         end;
  36.  
  37. {dat type defines directory entries}
  38.  
  39.      dir_entry_type = record
  40.                         fname : str8;
  41.                         fext  : str3;
  42.                         attr  : byte;
  43.                         reserved : packed array[0..9] of byte;
  44.                         time  : integer;
  45.                         date  : integer;
  46.                         first_cluster   : integer;
  47.                         filesize        : packed array [0..1] of integer;
  48.                       end;
  49.  
  50. {data type needed to pass path to recursive routines}
  51.  
  52.      name_type = string[80];
  53.  
  54. {if we have 12-bit fat entries, we keep 2 sectors of fat in ram,
  55.  if we have 16-bit fat entries, we keep 1 sector of fat in ram,
  56.  thus necessitating global definitions of which fat sector we have,
  57.  and global definitions of the fat buffers }
  58.  
  59. var
  60.    fat_sector : integer;
  61.    fname : string[80];
  62.    boot_sector : boot_sector_type;
  63.    i : integer;
  64.    root_sector : integer;
  65.    first_file_sector : integer;
  66.    fat16 : array[0..256] of integer;
  67.    fat12 : array[0..1024] of byte;
  68.    drivenum : byte;
  69.  
  70. {use interrupt $25 to read absolute disk sector}
  71. procedure read_sector(sector,segment,offset : integer);
  72.  
  73. var
  74.   x : byte;
  75.  
  76. begin
  77.   {first, push bp and ds to preserve them since $25 is a nasty one}
  78.   {then do a popf after the interrupt $25 to preserve the stack}
  79.   {test the carry bit to see if an error, then signal via the x variable}
  80.   {if an error, just croak out}
  81.   Inline(
  82.     $55                         {push bp}
  83.     /$1E                        {push ds}
  84.     /$3E/$A0/>DRIVENUM          {ds: mov al,[<drivenum]}
  85.     /$B9/$01/$00                {mov cx,1}
  86.     /$8B/$96/>SECTOR            {mov dx,>sector[bp]}
  87.     /$8B/$9E/>SEGMENT           {mov bx,>segment[bp]}
  88.     /$8E/$DB                    {mov ds,bx}
  89.     /$8B/$9E/>OFFSET            {mov bx,>offset[bp]}
  90.     /$CD/$25                    {int $25}
  91.     /$72/$05                    {jc  foo}
  92.     /$B0/$00                    {mov al,0}
  93.     /$E9/$02/$00                {jmp foo2}
  94.     /$B0/$01                    {foo: mov al,1}
  95.     /$9D                        {foo2: popf}
  96.     /$1F                        {pop ds}
  97.     /$5D                        {pop bp}
  98.     /$88/$46/<X                 {mov <x[bp],al}
  99.   );
  100.   if x=1 then begin
  101.     writeln('Cannot read disk');
  102.     halt(1);
  103.   end;
  104. end;
  105.  
  106. function cluster_to_sector(cluster : integer) : integer;
  107. {translate cluster number to sector number}
  108.  
  109. begin
  110.   cluster_to_sector:=((cluster-2)*boot_sector.sectors_per_cluster)+first_file_sector;
  111. end;
  112.  
  113. function next_sector16(sector : integer;var contiguous : boolean) : integer;
  114. {given a sector number, find the next sector, if the FAT has 16-bit entries}
  115. {return next sector=-1 if end of file}
  116.  
  117. var
  118.   result : integer;
  119.   oldcluster, cluster : integer;
  120.   new_fat_sector : integer;
  121.   rsector : real;
  122.  
  123. begin
  124.   rsector:=sector;
  125.   if rsector<0 then rsector:=rsector+65536.0;
  126.   result:=sector+1;
  127.   contiguous:=true;
  128.   if ((result-first_file_sector) mod boot_sector.sectors_per_cluster)=0 then begin
  129.     cluster:=trunc((rsector-first_file_sector) / boot_sector.sectors_per_cluster);
  130.     cluster:=cluster+2;
  131.     oldcluster:=cluster;
  132.     new_fat_sector:=(cluster*2) div boot_sector.bytes_per_sector;
  133.     if new_fat_sector<>fat_sector then begin
  134.       read_sector(new_fat_sector+boot_sector.reserved_sect,seg(fat16),ofs(fat16));
  135.       fat_sector:=new_fat_sector;
  136.     end;
  137.     cluster:=fat16[cluster mod (boot_sector.bytes_per_sector div 2)];
  138.     result:=cluster_to_sector(cluster);
  139.     if cluster=-1 then result:=-1;
  140.     if cluster=-2 then result:=-1;
  141.     if cluster=-3 then result:=-1;
  142.     if cluster=-4 then result:=-1;
  143.     if cluster=-5 then result:=-1;
  144.     if cluster=-6 then result:=-1;
  145.     if cluster=-7 then result:=-1;
  146.     if cluster=-8 then result:=-1;
  147.     if (result=-1) or (cluster=oldcluster+1) then
  148.       contiguous:=true
  149.     else
  150.       contiguous:=false;
  151.   end;
  152.   next_sector16:=result;
  153. end;
  154.  
  155. function next_sector12(sector : integer;var contiguous : boolean) : integer;
  156. {given a sector number, find the next sector, if the FAT has 12-bit entries}
  157. {return next sector=-1 if end of file}
  158. var
  159.   result : integer;
  160.   oldcluster, cluster : integer;
  161.   new_fat_sector : integer;
  162.   rsector : real;
  163.  
  164. begin
  165.   rsector:=sector;
  166.   if rsector<0 then rsector:=rsector+65536.0;
  167.   result:=sector+1;
  168.   contiguous:=true;
  169.   if ((result-first_file_sector) mod boot_sector.sectors_per_cluster)=0 then begin
  170.     cluster:=trunc((rsector-first_file_sector) / boot_sector.sectors_per_cluster);
  171.     cluster:=cluster+2;
  172.     oldcluster:=cluster;
  173.     new_fat_sector:=trunc(cluster*1.5) div boot_sector.bytes_per_sector;
  174.     if new_fat_sector<>fat_sector then begin
  175.       read_sector(new_fat_sector+boot_sector.reserved_sect,seg(fat12),ofs(fat12));
  176.       read_sector(new_fat_sector+boot_sector.reserved_sect+1,
  177.         seg(fat12[boot_sector.bytes_per_sector]),ofs(fat12[boot_sector.bytes_per_sector]));
  178.       fat_sector:=new_fat_sector;
  179.     end;
  180.     cluster:=fat12[trunc(oldcluster*1.5) mod boot_sector.bytes_per_sector];
  181.     cluster:=cluster+256*fat12[1+(trunc(oldcluster*1.5) mod boot_sector.bytes_per_sector)];
  182.     if odd(oldcluster) then
  183.       cluster:= (cluster shr 4) and $fff
  184.     else
  185.       cluster:= cluster and $fff;
  186.     result:=cluster_to_sector(cluster);
  187.     if cluster=$FFF then result:=-1;
  188.     if cluster=$FFE then result:=-1;
  189.     if cluster=$FFD then result:=-1;
  190.     if cluster=$FFC then result:=-1;
  191.     if cluster=$FFB then result:=-1;
  192.     if cluster=$FFA then result:=-1;
  193.     if cluster=$FF9 then result:=-1;
  194.     if cluster=$FF8 then result:=-1;
  195.     if (result=-1) or (cluster=oldcluster+1) then
  196.       contiguous:=true
  197.     else
  198.       contiguous:=false;
  199.   end;
  200.   next_sector12:=result;
  201. end;
  202.  
  203. function next_sector(sector : integer;var contiguous : boolean) : integer;
  204. {get next sector number, by first determining if FAT entries are 12 or}
  205. {16 bits, then calling the appropriate FAT reader}
  206.  
  207. var
  208.   result : integer;
  209.   rsectors : real;
  210.  
  211. begin
  212.   rsectors:=boot_sector.total_sectors;
  213.   if rsectors<0.0 then rsectors:=rsectors+65536.0;
  214.   if (rsectors / boot_sector.sectors_per_cluster) > 4087.0 then
  215.     result:=next_sector16(sector,contiguous)
  216.   else
  217.     result:=next_sector12(sector,contiguous);
  218.   next_sector:=result;
  219. end;
  220.  
  221. procedure list_file(sector : integer;name : name_type);
  222. {trace through each files sectors, counting fragments as we go}
  223.  
  224. var
  225.   i, j, cluster, osector : integer;
  226.   dir_sector : array[0..31] of dir_entry_type;
  227.   contiguous, done : boolean;
  228.   path,oname : name_type;
  229.  
  230. begin
  231.   i:=0;
  232.   done:=false;
  233.   while not(done)do begin
  234.     sector:=next_sector(sector,contiguous);
  235.     if not(contiguous) then i:=i+1;
  236.     if sector = -1 then done:=true;
  237.   end;
  238.   if (i>0) then writeln('file:',name,' fragmented in ',i+1,' pieces');
  239. end;
  240.  
  241. procedure makename(var oname : name_type;fname : str8;fext : str3);
  242. {convert DOS directory entry name to more readable format}
  243.  
  244. var
  245.   j : integer;
  246.  
  247. begin
  248.   if fname[0]=chr(5) then
  249.     oname:=chr(229)
  250.   else
  251.     oname:=fname[0];
  252.   for j:=1 to 7 do oname:=oname+fname[j];
  253.   if pos(' ',oname)<>0 then
  254.     delete(oname,pos(' ',oname),length(oname)+1-pos(' ',oname));
  255.   oname:=oname+'.';
  256.   for j:=0 to 2 do oname:=oname+fext[j];
  257.   if pos(' ',oname)<>0 then
  258.     delete(oname,pos(' ',oname),length(oname)+1-pos(' ',oname));
  259.   if pos('.',oname)=length(oname) then delete(oname,length(oname),1);
  260. end;
  261.  
  262. procedure list_directory(sector : integer;name : name_type);
  263. {recursively trace out a subdirectory}
  264.  
  265. var
  266.   pieces, i, j, cluster, osector : integer;
  267.   dir_sector : array[0..31] of dir_entry_type;
  268.   contiguous, done : boolean;
  269.   path,oname : name_type;
  270.  
  271. begin
  272.   {read first sector of directory}
  273.   read_sector(sector,seg(dir_sector),ofs(dir_sector));
  274.   {i keeps track of which directory entry we are using}
  275.   i:=0;
  276.   done:=false;
  277.   {count fragments as well}
  278.   pieces:=0;
  279.   while not(done)do begin
  280.     {if directory entry is a subdirectory or a file, do something}
  281.     if (dir_sector[i].fname[0]<>chr(0)) then begin
  282.       if (dir_sector[i].fname[0]<>deleted_entry) and
  283.          (dir_sector[i].fname[0]<>alias_entry) and
  284.          (volable <> (dir_sector[i].attr and volable)) then begin
  285.         {first make the pathname}
  286.         makename(oname,dir_sector[i].fname,dir_sector[i].fext);
  287.         {if subdirectory, go recurse, else just trace file}
  288.         if (dir_entry and dir_sector[i].attr=dir_entry) then begin
  289.           list_directory(cluster_to_sector(dir_sector[i].first_cluster),name+'\'+oname);
  290.         end else begin
  291.           list_file(cluster_to_sector(dir_sector[i].first_cluster),name+'\'+oname);
  292.         end;
  293.       end;
  294.       {try next dir entry}
  295.       i:=i+1;
  296.       {if no more in this sector, read next directory sector}
  297.       if i>=boot_sector.bytes_per_sector/dir_entry_size then begin
  298.         i:=0;
  299.         sector:=next_sector(sector,contiguous);
  300.         if not(contiguous) then pieces:=pieces+1;
  301.         if sector<> -1 then
  302.           read_sector(sector,seg(dir_sector),ofs(dir_sector))
  303.         else
  304.           done:=true;
  305.       end;
  306.     end else done:=true;
  307.   end;
  308.   if (pieces>0) then writeln('directory:',name,' fragmented in ',pieces+1,'pieces');
  309. end;
  310.  
  311. procedure list_root_directory(sector : integer);
  312. {identical to list_directory, but the root directory is special because}
  313. {It is guaranteed to be contiguous, and its sectors are NOT part of the FAT}
  314.  
  315. var
  316.   i, j, cluster, osector : integer;
  317.   dir_sector : array[0..31] of dir_entry_type;
  318.   done : boolean;
  319.   oname : name_type;
  320.  
  321. begin
  322.   read_sector(sector,seg(dir_sector),ofs(dir_sector));
  323.   i:=0;
  324.   done:=false;
  325.   while not(done)do begin
  326.     if (dir_sector[i].fname[0]<>chr(0)) then begin
  327.       if (dir_sector[i].fname[0]<>deleted_entry) and
  328.          (dir_sector[i].fname[0]<>alias_entry) and
  329.          (volable <> (dir_sector[i].attr and volable)) then begin
  330.         makename(oname,dir_sector[i].fname,dir_sector[i].fext);
  331.         oname:='\'+oname;
  332.         if (dir_entry and dir_sector[i].attr=dir_entry) then begin
  333.           list_directory(cluster_to_sector(dir_sector[i].first_cluster),oname);
  334.         end else begin
  335.           list_file(cluster_to_sector(dir_sector[i].first_cluster),oname);
  336.         end;
  337.       end;
  338.       i:=i+1;
  339.       if i>=boot_sector.bytes_per_sector/dir_entry_size then begin
  340.         i:=0;
  341.         sector:=sector+1;
  342.         read_sector(sector,seg(dir_sector),ofs(dir_sector));
  343.       end;
  344.     end else done:=true;
  345.   end;
  346. end;
  347.  
  348. var
  349.   drivelet : char;
  350.  
  351. begin
  352.      {get drive letter, convert to drive number}
  353.      write('Drive letter=');
  354.      read(kbd,drivelet);
  355.      writeln(drivelet);
  356.      if drivelet in ['a'..'z'] then drivelet:=chr(ord('A')+ord(drivelet)-ord('a'));
  357.      drivenum:=ord(drivelet)-ord('A');
  358.      {tell me that I have not read any FAT sector at all yet}
  359.      fat_sector:=-1;
  360.      {read the boot sector}
  361.      read_sector(0,seg(boot_sector),ofs(boot_sector));
  362.      {print out some of the pertinent information}
  363.      write('oem name=');
  364.      for i:=0 to 7 do write(boot_sector.oem_name[i]);
  365.      writeln;
  366.      writeln('number of boot sectors=',boot_sector.reserved_sect);
  367.      root_sector:=boot_sector.reserved_sect+boot_sector.number_fats*
  368.         boot_sector.sectors_per_fat;
  369.      writeln('root directory sector=',root_sector);
  370.      writeln('sectors/track=',boot_sector.sectors_per_track);
  371.      writeln('heads=',boot_sector.number_of_heads);
  372.      {calculate the offset basis for data sectors for cluster<->sector calculations}
  373.      first_file_sector:=(boot_sector.root_entries*dir_entry_size) div
  374.        boot_sector.bytes_per_sector;
  375.      first_file_sector:=first_file_sector+boot_sector.reserved_sect;
  376.      first_file_sector:=first_file_sector+boot_sector.sectors_per_fat *
  377.        boot_sector.number_fats;
  378.      {and start looking for fragments}
  379.      list_root_directory(root_sector);
  380. end.
  381.